home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / appoint.bas < prev    next >
Encoding:
BASIC Source File  |  1985-06-03  |  8.3 KB  |  180 lines
  1. 10 DIM G$(6),M(13)
  2. 20 FOR I = 1 TO 6:READ G$(I) :NEXT I
  3. 30 FOR I = 1 TO 13:READ M(I):NEXT I
  4. 40 CLS
  5. 50 INPUT "Are you starting a new nagging file (Y/N)";I$:IF I$ = "" THEN END
  6. 60 IF ASC(I$) > 90 THEN PRINT "Please type in upper case only.":GOTO 50
  7. 70  IF I$="N" THEN INPUT  "What is the name of the file you want to use";QU$:WR = 0:GOTO 100
  8. 80 INPUT "What name do you want to give it";QU$:IF QU$ = "" THEN 50
  9. 90 OPEN "O",1,"A:"+QU$+".NAG":WRITE #1,0,0:CLOSE #1:WR = 1
  10. 100 IF QU$ = "" THEN 50
  11. 110 OPEN "I",1,"A:"+QU$+".NAG":INPUT #1,N,E:NT = N + 50:ET = E + 10
  12. 120 DIM A$(NT),S(NT),F(NT),P(NT),L$(ET),T(ET)
  13. 130 FOR I = 1 TO N:INPUT #1,A$(I),S(I),F(I),P(I):NEXT I
  14. 140 FOR I = 1 TO E:INPUT #1,L$(I),T(I)
  15. 150 NEXT I:CLOSE #1
  16. 160 CLS:PRINT "Would you like to":PRINT
  17. 170 PRINT "  1. LIST ACTIVITIES FOR A PARTICULAR DAY"
  18. 180 PRINT "  2. List all events"
  19. 190 PRINT "  3. List activities relating to an event"
  20. 200 PRINT "  4. List all activities"
  21. 210 PRINT:PRINT "  5. Add a new event and activities relating to it"
  22. 220 PRINT "  6. Add activities relating to an event"
  23. 230 PRINT "  7. Delete an event and all activites relating to it"
  24. 240 PRINT "  8. Delete or change an activity":PRINT
  25. 250 PRINT "  9. Quit the program and save any changes"
  26. 260 PRINT:INPUT CH:CLS
  27. 270 ON CH GOSUB 1000,1100,1200,1300,1400,1500,1600,1700
  28. 280 IF CH > 4 AND CH < 9 THEN WR = 1
  29. 290 IF CH <> 9 AND N < (NT - 20) AND E < (ET - 5) THEN 160
  30. 300 Z = 0:FOR I = 1 TO N
  31. 310 IF P(I) = -1 THEN Z = Z + 1
  32. 320  A$(I) = A$(I + Z):P(I) = P(I + Z):S(I) = S(I + Z):F(I) = F(I + Z)
  33. 330 NEXT I:N = N - Z:X = 1
  34. 340 IF X > E THEN 410
  35. 350 Y = 0:FOR Z = 1 TO N:IF P(Z) = X THEN Y = 1
  36. 360 NEXT Z:IF Y = 1 THEN 400
  37. 370 FOR Y = X TO E:L$(Y) = L$(Y + 1):T(Y) = T(Y + 1):NEXT Y:E = E - 1
  38. 380 FOR Z = 1 TO N:IF P(Z) >X THEN P(Z) = P(Z) - 1
  39. 390 NEXT Z
  40. 400 X = X + 1:GOTO 340
  41. 410 IF CH <> 9 THEN 160
  42. 420 IF WR = 0 THEN PRINT "(No changes)":END
  43. 430 PRINT "Saving new data...":OPEN "O",1,"A:"+QU$+".NAG"
  44. 440 WRITE #1,N,E:FOR I = 1 TO N
  45. 450 WRITE #1,A$(I),S(I),F(I),P(I)
  46. 460 NEXT I:FOR I = 1 TO E
  47. 470 WRITE #1,L$(I),T(I):NEXT I:CLOSE #1:END
  48. 1000 PRINT "Enter the date you would like to look at ";:GOSUB 2700: IF U = 0 THEN RETURN
  49. 1010 FD = 0:BL = 0:T = U:FOR X = 0 TO 4:Y = 0:FOR I = 1 TO N:IF F(I) <> (T + X) OR S(I) > U OR P(I) = -1 THEN 1040
  50. 1020 IF Y = 0 THEN Y = 1:PRINT:PRINT G$(X + 1)
  51. 1030 GOSUB 2400:PRINT A$(I),S$,F$,L$(P(I))
  52. 1040 NEXT I:NEXT X:PRINT:BL = 0
  53. 1050 FOR I = 1 TO N:IF S(I) > T OR F(I) < (T + 5) OR P(I) = -1 THEN 1080
  54. 1060 IF FD = 1 AND BL = 0 THEN PRINT G$(6)
  55. 1070 GOSUB 2400:PRINT A$(I),S$,F$,L$(P(I))
  56. 1080 NEXT I:PRINT:IF FD = 0 THEN PRINT "  (No activities found)":GOSUB 2800:RETURN
  57. 1090 PRINT "   (That's all)":GOSUB 2800:RETURN
  58. 1100 PRINT "EVENT",,"Date":PRINT "-----",,"----"
  59. 1110 FOR I = 1 TO E:U = T(I):GOSUB 2500
  60. 1120 PRINT L$(I),,U$
  61. 1130 IF I / 20 = INT(I / 20) THEN GOSUB 2800
  62. 1140 NEXT I:PRINT:PRINT "   (That's all)":GOSUB 2800:RETURN
  63. 1200 GOSUB 2100:IF L = 0 THEN RETURN
  64. 1210 U = T(L):GOSUB 2500
  65. 1220 PRINT "          ---<< ";L$(L);" >--< ";U$;" >>---"
  66. 1230 PRINT:PRINT "Activity","Start date","End date"
  67. 1240 PRINT "--------","----------","--------":FD = 0
  68. 1250 FOR I = 1 TO N:IF P(I) <> L THEN 1280
  69. 1260 GOSUB 2400:PRINT A$(I)," ";S$,F$
  70. 1270 IF I/20 = INT(I/20) THEN GOSUB 2800
  71. 1280 NEXT I:IF FD = 0 THEN PRINT "No activities found."
  72. 1290 GOSUB 2800:RETURN
  73. 1300 FOR I=1 TO N:IF I = 1 THEN 1330
  74. 1310 IF I/14 > INT(I/14) THEN 1350
  75. 1320 GOSUB 2800
  76. 1330 CLS:PRINT "Activity","Start date","End date","Event"
  77. 1340 PRINT "--------","----------","--------","-----"
  78. 1350 IF P(I) = -1 THEN 1380
  79. 1360 GOSUB 2400
  80. 1370 PRINT A$(I)," ";S$,F$,L$(P(I))
  81. 1380 NEXT I:PRINT:PRINT "  (That's all)":GOSUB 2800:RETURN
  82. 1400 IF E < ET - 2 THEN 1430
  83. 1410 PRINT "If you wish to add another event please quit the program and run it again."
  84. 1420 GOSUB 2800:RETURN
  85. 1430 L$ = "":INPUT "Enter name of event";L$:IF L$ = "" THEN RETURN
  86. 1440 L = 0:FOR I = 1 TO E:IF L$(I) = L$ THEN L = 1
  87. 1450 NEXT I:IF L = 1 THEN PRINT "There is already an event by that name.":GOTO 1400
  88. 1460 PRINT "Enter date of ";L$;" ";:GOSUB 2700
  89. 1470 E = E + 1:L$(E) = L$:T(E) = U:L = E
  90. 1480 GOSUB 1900:RETURN
  91. 1500 GOSUB 2100:IF L=0 THEN RETURN
  92. 1510 GOSUB 1900:RETURN
  93. 1600 GOSUB 2100:IF L=0 THEN RETURN
  94. 1610 PRINT "Are you sure you want to delete ";L$;" (N/Y)";:INPUT I$
  95. 1620 IF I$ <> "Y" THEN RETURN
  96. 1630 FOR I = L  TO E
  97. 1640 L$(I) = L$(I+1):T(I) = T(I+1)
  98. 1650 NEXT I:E = E-1
  99. 1660 FOR I = 1 TO N
  100. 1670 IF P(I) = L THEN P(I) = -1
  101. 1680 IF P(I) > L THEN P(I) = P(I) - 1
  102. 1690 NEXT I:RETURN
  103. 1700 INPUT "Name of activity";A$:W = 0:FOR I = 1 TO N:IF A$(I) <> A$ OR P(I) = -1 THEN 1730
  104. 1710 W = W + 1:J = I:GOSUB 2400
  105. 1720 PRINT W;" - ";A$(I),S$,F$,L$(P(I))
  106. 1730 NEXT I
  107. 1740 IF W = 0 THEN PRINT "No activity ";CHR$(34);A$;CHR$(34);" is recorded":GOSUB 2800:RETURN
  108. 1750 IF W = 1 THEN I = J:GOTO 1810
  109. 1760 INPUT "Which of the above";J:IF J < 1 OR J > W THEN 1760
  110. 1770 I = 0:FOR K = 1 TO J
  111. 1780 I = I + 1:IF A$(I) <> A$ THEN 1780
  112. 1790 NEXT K:PRINT:GOSUB 2400
  113. 1800 PRINT A$,S$,F$,L$(P(I))
  114. 1810 INPUT "Change or delete this (Y/N)";I$
  115. 1820 IF I$ = "N" THEN RETURN
  116. 1830 GOSUB 2200
  117. 1840 IF LT = -1 THEN P(I) = -1
  118. 1850 RETURN
  119. 1900 IF N > NT - 5 THEN PRINT "If you wish to add any more activities, please quit the program and run it again.":GOSUB 2800:RETURN
  120. 1910 N = N + 1:LT = L
  121. 1920 A$ = "":INPUT "Enter activity name";A$:IF A$ = "" THEN RETURN
  122. 1930 PRINT "Enter start date ";:GOSUB 2700:S = U:S$ = U$
  123. 1940 PRINT "Enter end date   ";:GOSUB 2700:F = U:F$ = U$
  124. 1950 IF S > F THEN PRINT "Ending before started!":GOTO 1930
  125. 1960 A$(N) = LEFT$(A$,14):S(N) = S:F(N) = F:P(N) = LT:I = N
  126. 1970 IF P(I) = -1 THEN 2000
  127. 1980 PRINT:PRINT A$(N),S$,F$,L$(P(N))
  128. 1990 INPUT "Okay (Y/N)";I$:IF I$ = "N" THEN GOSUB 2200:GOTO 1950
  129. 2000 INPUT "Add another activity (Y/N)";I$:IF I$ = "N" THEN RETURN
  130. 2010 GOTO 1900
  131. 2100 INPUT "Name of event";L$:L = 0:FOR I = 1 TO E
  132. 2110 IF L$(I)=L$ THEN L = I
  133. 2120 NEXT I:IF L > 0 THEN 2140
  134. 2130 PRINT "There is no event ";CHR$(34);L$;CHR$(34):GOSUB 2800
  135. 2140 CLS:RETURN
  136. 2200 LT = L:INPUT "Delete it (N/Y)";I$
  137. 2210 IF I$ = "Y" THEN LT = -1:RETURN
  138. 2220 INPUT "New name (RETURN = old)";I$
  139. 2230 IF I$ <> "" THEN A$(I) = I$
  140. 2240 PRINT "New start date (RETURN = old) ";:GOSUB 2700
  141. 2250 IF U > 0 THEN S(I) = U:S = U
  142. 2260 PRINT "New end date   (RETURN = old) ";:GOSUB 2700
  143. 2270 IF U > 0 THEN F(I) = U:F = U
  144. 2280 IF S > F THEN PRINT "Ending before started!":GOTO 2240
  145. 2290 IF CH <> 8 THEN RETURN
  146. 2300 INPUT "New event (RETURN = old)";I$
  147. 2310 L = 0:IF I$ = ""  THEN RETURN
  148. 2320 FOR J = 1 TO E:IF L$(J) = I$ THEN L = J
  149. 2330 NEXT J:IF L = 0 THEN PRINT " No such event":GOTO 2300
  150. 2340 P(I) = L:RETURN
  151. 2400 U = S(I):GOSUB 2500:S$ = U$:FD = 1:BL = 1
  152. 2410 U = F(I):GOSUB 2500:F$ = U$:RETURN
  153. 2500 ME = 1:IF U < 366 THEN YR = 0:D = U:DA = U:GOTO 2540
  154. 2510 Y4 = INT((U-366)/1461) + 1:D4 = U + 1096 - 1461 * Y4
  155. 2520 YE = INT((D4 - 1)/365):IF YE = 4 THEN YE = 3
  156. 2530 YR = 4 * Y4 + YE - 3:D = D4 - 365 * YE
  157. 2540 IF D <= 31 THEN DA = D:ME = 1:GOTO 2590
  158. 2550 LP = INT(YR/4)*4 = YR AND YR <> 0
  159. 2560 IF D <= 59 - LP THEN DA = D - 31:ME = 2:GOTO 2590
  160. 2570 IF D <= M(ME+1) - LP THEN DA = D - M(ME) + LP:GOTO 2590
  161. 2580 ME = ME + 1:GOTO 2550
  162. 2590 U$ = RIGHT$(STR$(ME),2) + "/" + RIGHT$(STR$(DA),2) + "/" + RIGHT$(STR$(YR),2)
  163. 2600 FOR C = 1 TO 8:IF MID$(U$,C,1) = " " THEN MID$(U$,C,1) = "0"
  164. 2610 NEXT C:RETURN
  165. 2700 U = O:I$ = "":INPUT "(MM/DD/YY)";I$:IF I$ = "" THEN RETURN
  166. 2710 IF LEN(I$)<>8 OR MID$(I$,3,1)<>"/" OR MID$(I$,6,1)<>"/" THEN 2700
  167. 2720 ME = VAL(LEFT$(I$,2)):DA = VAL(MID$(I$,4,2)):YR = VAL(RIGHT$(I$,2))
  168. 2730 IF YR < 0 OR Y > 99 OR ME < 1 OR ME > 12 THEN 2700
  169. 2740 IF INT(YR/4) = YR/4 AND YR > 0 AND ME = 2 AND DA < 30 THEN 2760
  170. 2750 IF DA > M(ME + 1) - M(ME) THEN 2700 ELSE 2760
  171. 2760 LY = INT((YR-1)/4):IF LY < 0 THEN LY = 0
  172. 2770 M = M(ME):IF ME > 2 AND INT(YR/4) * 4 = YR AND YR <> 0 THEN M = M + 1
  173. 2780 U = YR * 365 + LY + M + DA:GOSUB 2500:RETURN
  174. 2800 PRINT:PRINT "Press any key to continue...";
  175. 2810 X$ = INKEY$ : IF X$ = "" THEN 2810
  176. 2820 PRINT:RETURN
  177. 2900 DATA Urgent! Today is the last day for...,Warning! Only one day left for...,Better hurry! Only two days left for...
  178. 2910 DATA Don't forget! Only three days left for...,Pay attention! Only four days left for...,Also remember...
  179. 2920 DATA 0,31,59,90,120,151,181,212,243,273,304,334,365
  180.